let _ = GMain.init ()
let envlist = ref []
let currenv = ref None
let tool_buttons = Array.make 10 None


let set_currentenv env =
  currenv := Some(env)

let exitProg () =
  GMain.Main.quit ()

let mainwin = GWindow.window
                ~resizable:true
                ~title:"Progeo"
                ()

let fullwin =
  GPack.vbox
    ~spacing: 0
    ~border_width:0
    ~packing:mainwin#add
    ()

exception NotInitialized
let v = function
    Some(e) -> e
  | None -> raise NotInitialized

class draggable_content hbox packfun label =
    let box = GBin.frame
            ~label: (label)
            ~border_width:2
            ~packing:packfun
            ()
    in
object
        val contener = box
        method contener = box
end


(* GL/datas environment *)
class mapenv
      setcurrent
      (manager:GPack.notebook)
      (status:GMisc.statusbar)
      (toolbar:GButton.toolbar)
      file
      fullpath
      buttons
      =
  let fullcontent = GPack.hbox ()
  in
  let contener = GPack.hbox ()
  in
  let label = GMisc.label
                ~text:file
                ~packing: contener#add
                ()
  in
  let labelb = GButton.button
                 ~label: "X"
                 ~packing: contener#add
                 ()
  in

  let get_id () = manager#page_num fullcontent#coerce
  in
  let _ = manager#goto_page (get_id ())
  in
  let _ = labelb#connect#clicked (fun _ ->
                                    manager#remove_page (get_id ()); ())
  in
    let notdraw = GMisc.label
                  ~text:("I'm afraid, I cannot display this map!"^
                  "\n\nPlease fill in the colors-to-altitudes array."^
                  "\nSwith to normal mode clicking the fullscreen button.")
                  ~packing:fullcontent#add
                  ~show:false
                  ()
  in
    let stbar = status#new_context file
    in
object(self)
  val tools = toolbar
  val tabmanager = manager
  val fullcontener = contener
  val tabtitle = label
  val mutable glspace = None
  val mutable rightspace = None
  val mutable map = None
  val mutable evbox = None
  val mutable bbox = None
  val mutable minibox = None
  val mutable temp_obj = ""
  val mutable temp_colorsval = ""
  val mutable temp_general = ""
  val mutable temp_contour = ""
  val mutable currpos = (0.,0.,0.)
  val mutable currtau = 0.
  val mutable currprec = 0.
  val mutable currscale = 0.
  val datas = new Alldatas.alldatas ()

  method print_pos (x,y,z) =
    "Current camera position: {x = "^(string_of_float x)
                              ^" | y = "^(string_of_float z)
                              ^" | z = "^(string_of_float y)
                              ^"}"
  method private cpyfile inf out =
       let buf = open_in_bin inf
       and outbuf = open_out_bin out
       in
         try
           while true do
             Printf.fprintf outbuf "%c" (input_char buf)
           done
         with _-> close_in buf; close_out outbuf; ()

  method can_save_something =
    temp_obj <> ""

  method save_obj s =
    self#cpyfile temp_obj s

  method save_contour s =
    self#cpyfile temp_contour s

  method save_alt s =
    self#cpyfile temp_colorsval s


  method push s =
    ignore(stbar#push s);
    ()

  method print_focus () =
    if((v glspace)#hasfocus) then
      "Keyboard focus : yes | "^(self#print_pos currpos)
    else
      "Keyboard focus : no | "^(self#print_pos currpos)^
      " | Click on 3D window to get keyboard handling for movement."

  method focus () =
    self#push (self#print_focus ())

  method set_speed sp =
    (v glspace)#set_speed sp

  method poschange id pos animate =
    if (id = 0) then
      (v map)#set_position pos
    else
      (v glspace)#set_position pos animate;
    currpos<-pos;
    self#focus ()

  method set_pos_dir pd =
    (v glspace)#set_pos_dir pd

  method get_dir =
    (v glspace)#get_dir;
  method ch_colors leg ()=
    datas#change_legend leg;
    let (mtrx_h,mtrx_d,w,h,getdistcall,_) = datas#get_tesselmtrx ()
    in
    getdistcall leg;
    datas#set_mapalts (Tesselator.write_triangles_with_infected
                         temp_obj mtrx_h mtrx_d w h currtau
                         (int_of_float currprec) currscale) currscale;
    (v glspace)#reload_infos currscale ()

  method changetauscale mtrx_h mtrx_d w h tau scale realscale () =
    currtau <- tau;
    currprec <- scale;
    currscale <- realscale;
      datas#set_mapalts (Tesselator.write_triangles_with_infected
                           temp_obj mtrx_h mtrx_d w h tau
                           (int_of_float scale) realscale) currscale;
      (v map)#change_scale realscale;
      (v glspace)#reload_infos realscale ()


  method init_fullmode tau slope scale=
    currtau <- tau;
    currprec <- slope;
    currscale <- scale;
    temp_contour <- Filename.temp_file "contour" ".bmp";
    let (img_base,mtrx_h,mtrx_d,w,h,leg,getdistcall) =
      Imgprocess.compute fullpath temp_colorsval temp_contour
    in
      temp_obj <- Filename.temp_file "card" ".obj";
      datas#set_tesselmtrx mtrx_h mtrx_d w h getdistcall leg;
      getdistcall leg;
      datas#set_mapalts (Tesselator.write_triangles_with_infected
                           temp_obj mtrx_h mtrx_d w h tau
                           (int_of_float slope) scale) scale;
      (v bbox)#misc#hide ();
    let mlw =((Guismall.get_lightings_widgets_contener self#set_speed
                 (fun () -> (currpos,self#get_dir))
                 self#set_pos_dir ())#coerce)
    and gsw =((Guismall.get_generaldatas_widgets_contener tau slope scale
                 (self#changetauscale mtrx_h mtrx_d w h) ())#coerce)
     and clw =((Guismall.get_colorselect_widgets_contener
                  temp_colorsval (self#ch_colors))#coerce)
    and (labels,labelsc) = (datas#get_labels ())
    in
     let gll = new Guigl.glspace temp_obj
                 (fullcontent#pack ~expand:true)
                 labels labelsc (temp_colorsval) scale
    in
      glspace <- Some(gll);
      (v buttons.(0))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       self#best_show ()
      );
      (v buttons.(1))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       self#show_l ()
      );
      (v buttons.(2))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       self#show_r ()
      );
      (v buttons.(3))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       self#show_up ()
      );
      (v buttons.(4))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       self#show_down ()
      );
      (v buttons.(5))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       self#show_back ()
      );
      (v buttons.(6))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       self#show_front ()
      );
      (v buttons.(7))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       gll#set_wired true
      );
      (v buttons.(8))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       gll#set_wired false
      );
      (v buttons.(9))#connect#clicked
        ~callback:(fun () ->
                     if manager#current_page = get_id () then
                       self#show_center ()
      );
      ignore(gll#init self#poschange self#focus ());
      gll#reset_draw_focus ();
      let swin = GBin.scrolled_window
                  ~hpolicy:`NEVER
                  ~vpolicy:`AUTOMATIC
                   ~packing:fullcontent#pack ()
      in
      let rrs = GPack.vbox
                  ~packing:swin#add_with_viewport
                  ()
      in
      let mini =new draggable_content true rrs#pack "Minimap"
      and light = new draggable_content true rrs#pack "Movment settings"
      and gs = new draggable_content true rrs#pack "General settings"
      and ls = new draggable_content true rrs#add "Color/alt. settings"
      in
      let (_lbls,_) = datas#get_labels ()
      in
      let minimap =  new Guiminimap.minimap mini#contener
                       fullpath (_lbls) (labelsc) (gll#set_sel_mod)
      in
      ignore(manager#connect#switch_page ~callback:(fun idpage ->
                                               if idpage = get_id () then
                                                 begin
                                                   setcurrent self;
                                                   minimap#active
                                                     ();
                                                   gll#reset_draw_focus
                                                     ()
                                                 end
                                               else
                                                 begin
                                                   minimap#unactive
                                                     ();
                                                   gll#kill_draw_no_focus
                                                     ();
                                                 end
      ));
        minibox <- Some(mini);
        map <- Some(minimap);
        rightspace <- Some(rrs);
        light#contener#add mlw;
        gs#contener#add gsw;
        ls#contener#add clw;
        ignore(minimap#init self#poschange scale ());
        minimap#repaint ();
        let sevbox = GBin.event_box
                   ~show:false
                   ~packing:contener#add
                   ()
        in
          evbox <- Some(sevbox);
          sevbox#event#add [`BUTTON_PRESS];
	  ignore(sevbox#event#connect#button_press
            ~callback:(fun _ -> ignore(manager#goto_page (get_id ()));
                                true));
   self#show_r ();
   self#push "3D map calculated with success.";
	()

  (* switch to edit mode (hide 3d),
   * set 2d full-sreen, update
   * toolbar, etc...
   *)
  method switch_to_edit_mode = ()
  (* color <-> alt attribution mode *)
  method switch_to_pickcolormode = ()
  (* switch to normal view mode *)
  method switch_to_normalmode () =
    label#misc#show ();
    labelb#misc#show ();
    match map with
        Some(_) ->
          (v bbox)#misc#hide ();
          notdraw#misc#hide ();
          (v map)#area#misc#reparent (v minibox)#contener#coerce;
          (v evbox)#misc#show ();
          (v rightspace)#misc#show ()
      | _ ->
          (
            (v bbox)#misc#show ();
            notdraw#misc#hide ()
          )
  (* activates a toolbar's action *)
  method activate action =
    if action = "" then
      ()
    else
      ()

  (* switch to fullscreen view mode *)
  method switch_to_viewmode () =
    match map with
        Some(_) ->
          (v bbox)#misc#hide ();
          notdraw#misc#hide ();
          (v evbox)#misc#show ();
          (v map)#area#misc#reparent (v evbox)#coerce;
          (v rightspace)#misc#hide ();
          label#misc#hide ();
          labelb#misc#hide ()
      | _ ->
          (
            (v bbox)#misc#hide ();
            notdraw#misc#show ()
          )

  method best_show () =
    (v glspace)#best_show (datas#get_bsphere ())
  method show_r () =
    (v glspace)#show_r (datas#get_bsphere ())
  method show_up () =
    (v glspace)#show_up (datas#get_bsphere ())
  method show_back () =
    (v glspace)#show_back (datas#get_bsphere ())
  method show_front () =
    (v glspace)#show_front (datas#get_bsphere ())
  method show_l () =
    (v glspace)#show_l (datas#get_bsphere ())
  method show_down () =
    (v glspace)#show_down (datas#get_bsphere ())
  method show_center () =
    (v glspace)#show_center (datas#get_bsphere ())
  method init () =
    temp_colorsval <- Filename.temp_file "colors" ".alt";
    let (box,labels,labelsc) = Guismall.get_bigcolorselect
                                 (self#init_fullmode) fullpath
                                 temp_colorsval in
    bbox <- Some(box);
    datas#set_labels labels labelsc;
    ignore(manager#append_page
              ~tab_label: contener#coerce
              fullcontent#coerce);
    ignore(manager#goto_page (get_id ()));
    setcurrent self;
    ignore(stbar#push (fullpath ^
                       " opened. Choose an altitude for each color."));
    fullcontent#add (v bbox)#coerce

end



(* open file *)
let badFile () =
  let dlg = GWindow.message_dialog
    ~message:("<b><big>Invalid map!"^
            " Select another picture file.</big></b>\n\n")
    ~parent:mainwin
    ~destroy_with_parent:false
    ~use_markup:true
    ~message_type:`ERROR
    ~position:`CENTER_ON_PARENT
    ~buttons:GWindow.Buttons.ok
    ()
  in
  let _ = dlg#run () in
    dlg#destroy ();
    ()


exception Truc
let select_file fs manager tab tool noisecorrect filename =
	try
	let nenv =
          new mapenv set_currentenv  manager tab tool
            (Filename.basename filename)
            filename tool_buttons
	in
	nenv#init ();
	envlist := nenv::!envlist;
	fs#destroy ();
()
	with
	_->
          fs#destroy (); badFile ()

let open_map manager tab tool noise ()=
    let fs = GWindow.file_chooser_dialog
               ~action:`OPEN
               ~title:"Choose a map"
               ~modal: true
               ~position:`CENTER_ON_PARENT
               ~parent:mainwin
               ()
    in
      begin
        fs#add_select_button_stock `OPEN `OPEN;
        if(fs#run () = `OPEN) then
          match fs#filename with
            | Some(s) ->
                select_file fs manager tab tool noise s
            | _ -> ()
      end

let save_object f title =
let fs = GWindow.file_chooser_dialog
               ~action:`SAVE
               ~title:title
               ~modal: true
               ~position:`CENTER_ON_PARENT
               ~parent:mainwin
               ()
    in
      begin
        fs#add_select_button_stock `SAVE `SAVE;
        if(fs#run () = `SAVE) then
          begin
            (
              match fs#filename with
                | Some(s) ->
                    f s
                | _ -> ()
            );
          end;
        fs#destroy ();
      end

let export_file obj () =
  let save_some =
   ( match !currenv with
          | None -> false
          |Some(e) -> e#can_save_something
   )
  in
    if save_some then
      begin
        if obj = 0 then
          save_object
            (
              fun s ->
                match !currenv with
                  | None -> ()
                  |Some(e) -> e#save_obj s
            )
            "Save obj file"
        else if obj = 1 then (* alts *)
          save_object
                (
                  fun s ->
                    match !currenv with
                      | None -> ()
                      |Some(e) -> e#save_alt s
                )
                "Save altitudes file"
        else if obj = 2 then
          save_object
            (
              fun s ->
                match !currenv with
                  | None -> ()
                  |Some(e) -> e#save_contour s
            )
            "Save contour-detection file";
        ()
      end

(* Main menu *)
let fileEntries manager tab tool =
  [
    `I ("Open map...", open_map manager tab tool false);
    `I ("Open noised map...", open_map manager tab tool true);
    `S;
    `I ("Export .obj file...", export_file 0 );
    `I ("Export altitude file...", export_file 1);
    `I ("Export contour-detection image...", export_file 2);
    `S;
    `I ("Quit", exitProg);
  ]

let addMenu label menubar =
  let optionList = GMenu.menu_item
                     ~label:label
                     ~packing:menubar#append
                     ()
  in
    GMenu.menu ~packing:optionList#set_submenu ()

let mainMenu tabs status tools =
  let menu = GMenu.menu_bar ()
  in
  let fileMenu = addMenu "File" menu in
    (GToolbox.build_menu
      fileMenu
      ~entries:(fileEntries tabs status tools)
    );
    let itemabout = (GMenu.menu_item
                     ~label:"About..."
                     ~packing:menu#append
                     ())
    in
      ignore(itemabout#connect#activate
               ~callback:Guiapropos.get_apropos_box);
    menu


(* display modes *)
let to_viewmode vmod tablist (tool:GButton.toolbar)
      (menu:GMenu.menu_shell) (manager:GPack.notebook)
      (status:GMisc.statusbar) () =
  if(!vmod) then
    begin
      mainwin#fullscreen ();
      manager#set_tab_pos `RIGHT;
      menu#misc#hide ();
      (*status#misc#hide (); *)
      List.iter (fun (t:mapenv) -> t#switch_to_viewmode ()) !tablist
    end
  else
    begin
      mainwin#unfullscreen ();
      manager#set_tab_pos `TOP;
      menu#misc#show ();
      (*status#misc#show ();*)
      List.iter (fun (t:mapenv) -> t#switch_to_normalmode ()) !tablist
    end;
  vmod := not(!vmod)


(* toolbar *)
let initToolbar (bar:GButton.toolbar) () =
    ()

let tools ()=
  let toolbar = GButton.toolbar
    ~tooltips:true
    ()
  in
    initToolbar toolbar ();
    toolbar


(* notebook *)
let destroy_current_tab (manager:GPack.notebook) () =
  ()

let ongletsManager () =
  GPack.notebook
    ~tab_pos:`TOP
    ~scrollable:true
    ()

(* status bar *)
let status () =
  GMisc.statusbar
    ()
let try_add_env nofail manager tab tool s =
  try
    let nenv = (new mapenv set_currentenv manager tab tool
             (Filename.basename s)
             s tool_buttons)
    in
      nenv#init ();
      print_endline ("Progeo: File '"^s^"' openned successfully "^
                     "--> new tab created.");
      nofail := true
  with
    |_ -> print_endline ("Progeo: The file '"^s^
                         "' does not exist or does not have"^
                         " a valid format --> ignored.")


(* mainp *)
let mainp fullscreen file files () =
  ignore(mainwin#connect#destroy ~callback:exitProg);
  mainwin#show ();
  if fullscreen then
    mainwin#fullscreen ();
  let ong = ongletsManager () in
  let st = status () in
  let tool = tools () in
  let menu = mainMenu ong st tool in
    begin
      let vmod = ref true in
      ignore(tool#insert_button
        ~icon:(Imgbutton.create_img_widget "fscreen.png")#coerce
        ~tooltip:"Switch to full screen view"
        ~callback:(to_viewmode vmod envlist tool menu ong st)
        ());
        ignore(tool#insert_space ());
        tool_buttons.(0) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cubebetter.png")#coerce
        ~tooltip:"Best view"
        ());
        tool_buttons.(9) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cubecenter.png")#coerce
        ~tooltip:"Go to center"
        ());
        tool_buttons.(1) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cube.png")#coerce
        ~tooltip:"View left"
        ());
        tool_buttons.(5) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cubeback.png")#coerce
        ~tooltip:"View back"
        ());
        tool_buttons.(2) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cuberigth.png")#coerce
        ~tooltip:"View right"
        ());
        tool_buttons.(6) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cubefront.png")#coerce
        ~tooltip:"View front"
        ());

        tool_buttons.(3) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cubetop.png")#coerce
        ~tooltip:"View up"
        ());
        tool_buttons.(4) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cubebottom.png")#coerce
        ~tooltip:"View down"
        ());
        ignore(tool#insert_space ());
        tool_buttons.(7) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cubewire.png")#coerce
        ~tooltip:"Switch to wired mode"
        ());
        tool_buttons.(8) <- Some (tool#insert_button
        ~icon:(Imgbutton.create_img_widget "cubeplain.png")#coerce
        ~tooltip:"Switch to solid mode"
        ());

      fullwin#pack menu#coerce;
      fullwin#pack tool#coerce;
      fullwin#add ong#coerce;
      fullwin#pack st#coerce;
      match files with
        |None -> ()
        |Some(s) ->
            (
            let nofail = ref false in
            List.iter
              (try_add_env nofail ong st tool)
              (Str.split (Str.regexp_string " ") s);
            if not(!nofail) then
              begin
                print_endline
                  "No valid image in the given list... Aborted.";
                exit 0;
              end);
                                                   ;
      match file with
        |None -> ()
        |Some(s) ->
            (
            let nofail = ref false in
            try_add_env nofail ong st tool s;
            if not(!nofail) then
              begin
                print_endline "No valid image selected... Aborted.";
                exit 0;
              end);


    end;
  GMain.Main.main ()

let correctnoise path =
  Sdl.init [`EVERYTHING];
  Noisecorrection.execute (Sdlloader.load_image path) "" true

let oplist = Arg.align [
  "-fs", Arg.Unit (mainp true None None),
  " Launch the program in full screen";
  "-f", Arg.String (fun s -> mainp false (Some(s)) None ()),
  (Printf.sprintf (" Open the file you have specified the path with the program \n          Exemple : %s -f ~/mymaps/map3")
     (Sys.argv.(0)));
  "-af", Arg.String (fun s -> mainp false None (Some(s)) ()),
  (Printf.sprintf (" Open all files you have specified the path with the program \n          Exemple : %s -af '~/mymaps/map3 ~/mymaps/map43'") (Sys.argv.(0)));
  "-nc", Arg.String (fun s -> correctnoise s),
  (Printf.sprintf (" Only apply the noise correction algorithm to the specified file. \n          The corected image is printed on stdout. \n          Exemple : %s -nc mapwithnoise.bmp") (Sys.argv.(0)))
]


let main () =
  let usage_msg =
    Printf.sprintf ("Progeo is a mapping program for creat a 3D representation of a 2D map file. \nUsage: %s [option]... [file]...\nOptions:") (Sys.argv.(0)) in
    if (Array.length Sys.argv) = 1 then
      mainp false None None ()
    else
      begin
        Arg.parse oplist (fun _ -> ()) usage_msg;
        if not (Sys.argv.(1) = "-f"
                  || Sys.argv.(1) = "-fs"
                  || Sys.argv.(1) = "-af"
                  || Sys.argv.(1) = "-nc"
                  || Sys.argv.(1) = "-help"
                  || Sys.argv.(1) = "--help") then
          Arg.usage oplist usage_msg;
      end;
    exit 0

let _ = main ()

